home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1988 July / 64er_Magazin_88-07_1988_Markt__Technik_de_Side_A.d64 / roemische zahlen (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1988-01-01  |  2.2 KB  |  119 lines
  1. 10 rem **********************
  2. 20 rem *                    *
  3. 30 rem *  roemische zahlen  *
  4. 40 rem *                    *
  5. 50 rem * (w) j.baumm        *
  6. 60 rem * (c) 64'er     1988 *
  7. 70 rem *                    *
  8. 80 rem **********************
  9. 90 rem
  10. 100 poke 53280,2
  11. 110 poke 53281,7
  12. 120 poke 646,0
  13. 130 rem
  14. 140 rem menue
  15. 150 rem
  16. 160 dim r(13),r$(13)
  17. 170 :
  18. 180 print "[147]64'er":fa=0
  19. 190 print tab(7)"roemisch --> dezimal   [1]"
  20. 200 print tab(7)"dezimal  --> roemisch  [2]"
  21. 210 print tab(7)"e n d e  -->           [3]"
  22. 220 get t$:if t$<"1" or t$>"3" then 220
  23. 230 t=val (t$)
  24. 240 on tgoto 260,570,1180
  25. 250 rem
  26. 260 rem roemisch -> dezimal
  27. 270 rem
  28. 280 z1=0:z2=0:z3=0:dc=0:fg=0:r$=""
  29. 290 p1=0:p2=0:p3=0:p4=0:p5=0:p6=0
  30. 300 print "[147]":fa=1
  31. 310 input " roemische zahl";ro$
  32. 320 for i=len (ro$) to 1 step -1
  33. 330 r$=mid$ (ro$,i,1)
  34. 340 :
  35. 350 if r$<>"i" and r$<>"v" and r$<>"x" and r$<>"l" and r$<>"c" then y=0:goto 370
  36. 360 y=1
  37. 370 if y=0 and r$<>"d" and r$<>"m" then:gosub 910:goto 260
  38. 380 if r$="i" then r=1:p1=p1+1:if z1=1 then r=-1
  39. 390 if r$="v" then r=5:z1=1:p2=p2+1
  40. 400 if r$="x" then r=10:z1=1:p3=p3+1:if z2=1 then r=-10
  41. 410 if r$="l" then r=50:z2=1:p4=p4+1
  42. 420 if r$="c" then r=100:z2=1:p5=p5+1:if z3=1 then r=-100
  43. 430 if r$="d" then r=500:z3=1:p6=p6+1
  44. 440 if r$="m" then r=1000:z3=1
  45. 450 dc=dc+r
  46. 460 next i
  47. 470 gosub 640
  48. 480 rem
  49. 490 rem vergleich
  50. 500 rem
  51. 510 if ro$<>rm$ then gosub 910
  52. 520 if fg=1 then 260
  53. 530 gosub 990
  54. 540 gosub 1090
  55. 550 if a$="j" then 260
  56. 560 goto 180
  57. 570 gosub 590
  58. 580 rem
  59. 590 rem dezimal -> roemisch
  60. 600 rem
  61. 610 :fa=2
  62. 620 input "[147] dezimale zahl";d:de=d
  63. 630 if d<0 or d>240000 then gosub 940:goto 620
  64. 640 if fa=1 then d=dc
  65. 650 for i=1 to 13
  66. 660 read da,da$
  67. 670 r(i)=int (d/da)
  68. 680 d=d-(r(i)*da)
  69. 690 r$=""
  70. 700 if r(i)>1 then gosub 860:goto 720
  71. 710 if r(i)>0 then r$(i)=da$
  72. 720 next i
  73. 730 rem
  74. 740 rem roemische zahl
  75. 750 rem
  76. 760 for i=1 to 13
  77. 770 rm$=rm$+r$(i):r$(i)=""
  78. 780 next i
  79. 790 if fa=1 then 820
  80. 800 gosub 990
  81. 810 if fa=2 then 830
  82. 820 return
  83. 830 gosub 1090
  84. 840 if a$="j" then goto 570
  85. 850 goto 180
  86. 860 for j=1 to r(i)
  87. 870 r$(i)=r$(i)+da$
  88. 880 next j
  89. 890 return
  90. 900 rem
  91. 910 rem falsche eingabe
  92. 920 rem
  93. 930 fg=1
  94. 940 print " eingabefehler!"
  95. 950 for x=1 to 200:next x
  96. 960 restore:rm$="":ro$=""
  97. 970 return
  98. 980 rem
  99. 990 rem print
  100. 1000 rem
  101. 1010 if fa=1 then 1030
  102. 1020 if fa=2 then 1050
  103. 1030 print "  ";ro$;" =";dc
  104. 1040 goto 1070
  105. 1050 print " ";de;"= ";rm$
  106. 1060 restore:rm$=""
  107. 1070 return
  108. 1080 rem
  109. 1090 rem wiederholung
  110. 1100 rem
  111. 1110 print " nochmal (j/n)"
  112. 1120 get a$:if a$<>"j" and a$<>"n" then 1120
  113. 1130 restore:ro$="":rm$=""
  114. 1140 return
  115. 1150 data 1000,"m",900,"cm",500,"d",400,"cd",100,"c"
  116. 1160 data 90,"xc",50,"l",40,"xl",10,"x",9,"ix",5,"v",4,"iv",1,"i"
  117. 1170 rem
  118. 1180 end
  119.